﻿unit mprint;

interface

uses Printers, Windows, Classes, SysUtils, Forms;
procedure PrintTextRect(rect: TRect; Txt: string; FontSize: integer;
  align: integer = DT_CENTER);

procedure DrawLine(BX, BY, EX, EY, OFFX, OFFY: integer);

procedure SetPaperHeight(Value: integer);
Procedure SetPaperWidth(Value: integer);

implementation

// 取得字符的高度
function CharHeight: Word;

var
  Metrics: TTextMetric;
begin
  GetTextMetrics(Printer.Canvas.Handle, Metrics);
  Result := Metrics.tmHeight;
end;

// 取得字符的平均宽度
function AvgCharWidth: Word;

var
  Metrics: TTextMetric;
begin
  GetTextMetrics(Printer.Canvas.Handle, Metrics);
  Result := Metrics.tmAveCharWidth;
end;

// 取得纸张的物理尺寸---单位：点
function GetPhicalPaper: TPoint;

var
  PageSize: TPoint;
begin
  // PageSize.X; 纸张物理宽度-单位:点
  // PageSize.Y; 纸张物理高度-单位:点
  Escape(Printer.Handle, GETPHYSPAGESIZE, 0, nil, @PageSize);
  Result := PageSize;
end;

// 2.取得纸张的逻辑宽度--可打印区域
// 取得纸张的逻辑尺寸
function PaperLogicSize: TPoint;

var
  APoint: TPoint;
begin
  APoint.X := Printer.PageWidth;
  APoint.Y := Printer.PageHeight;
  Result := APoint;
end;

// 纸张水平对垂直方向的纵横比例
function HVLogincRatio: Extended;

var
  AP: TPoint;
begin
  AP := PaperLogicSize;
  Result := AP.Y / AP.X;
end;

// 取得纸张的横向偏移量-单位：点
function GetOffSetX: integer;
begin
  Result := GetDeviceCaps(Printer.Handle, PhysicalOffSetX);
end;

// 取得纸张的纵向偏移量-单位：点
function GetOffSetY: integer;
begin
  Result := GetDeviceCaps(Printer.Handle, PhysicalOffSetY);
end;

// 毫米单位转换为英寸单位
function MmToInch(Length: Extended): Extended;
begin
  Result := Length / 25.4;
end;

// 英寸单位转换为毫米单位
function InchToMm(Length: Extended): Extended;
begin
  Result := Length * 25.4;
end;

// 取得水平方向每英寸打印机的点数
function HPointsPerInch: integer;
begin
  Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
end;

// 取得纵向方向每英寸打印机的光栅数
function VPointsPerInch: integer;
begin
  Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
end;

// 横向点单位转换为毫米单位
function XPointToMm(Pos: integer): Extended;
begin
  Result := Pos * 25.4 / HPointsPerInch;
end;

// 纵向点单位转换为毫米单位
function YPointToMm(Pos: integer): Extended;
begin
  Result := Pos * 25.4 / VPointsPerInch;
end;

// 设置纸张高度-单位：mm
procedure SetPaperHeight(Value: integer);

var
  Device: array [0 .. 255] of char;
  Driver: array [0 .. 255] of char;
  Port: array [0 .. 255] of char;
  hDMode: THandle;
  PDMode: PDEVMODE;
begin
  Printer.PrinterIndex := Printer.PrinterIndex;
  Printer.GetPrinter(Device, Driver, Port, hDMode);
  if hDMode <> 0 then
  begin
    PDMode := GlobalLock(hDMode);
    if PDMode <> nil then
    begin
      PDMode^.dmFields := PDMode^.dmFields or DM_PAPERSIZE or DM_PAPERLENGTH;
      PDMode^.dmPaperSize := DMPAPER_USER;
      PDMode^.dmPaperLength := Value * 10;
      PDMode^.dmFields := PDMode^.dmFields or DMBIN_MANUAL;
      PDMode^.dmDefaultSource := DMBIN_MANUAL;
      GlobalUnlock(hDMode);
    end;
  end;
  Printer.PrinterIndex := Printer.PrinterIndex;
end;

// 设置纸张宽度：单位--mm
Procedure SetPaperWidth(Value: integer);

var
  Device: array [0 .. 255] of char;
  Driver: array [0 .. 255] of char;
  Port: array [0 .. 255] of char;
  hDMode: THandle;
  PDMode: PDEVMODE;
begin
  Printer.PrinterIndex := Printer.PrinterIndex;
  Printer.GetPrinter(Device, Driver, Port, hDMode);
  if hDMode <> 0 then
  begin
    PDMode := GlobalLock(hDMode);
    if PDMode <> nil then
    begin
      PDMode^.dmFields := PDMode^.dmFields or DM_PAPERSIZE or DM_PAPERWIDTH;
      PDMode^.dmPaperSize := DMPAPER_USER;
      // 将毫米单位转换为0.1mm单位
      PDMode^.dmPaperWidth := Value * 10;
      PDMode^.dmFields := PDMode^.dmFields or DMBIN_MANUAL;
      PDMode^.dmDefaultSource := DMBIN_MANUAL;
      GlobalUnlock(hDMode);
    end;
  end;
  Printer.PrinterIndex := Printer.PrinterIndex;
end;

procedure PrintTextRect(rect: TRect; Txt: string; FontSize: integer;
  align: integer = DT_CENTER);
var
  h, w, lineCnt,trim,times: integer;
begin
  rect.Left := Round(rect.Left * HPointsPerInch / 25.4);
  rect.Top := Round(rect.Top * VPointsPerInch / 25.4);
  rect.Right := Round(rect.Right * HPointsPerInch / 25.4);
  rect.Bottom := Round(rect.Bottom * VPointsPerInch / 25.4);

  Printer.Canvas.Font.Name := '宋体';
  Printer.Canvas.Font.Size := FontSize;
  w := Printer.Canvas.TextWidth(Txt);
  h := Printer.Canvas.TextHeight(Txt);
  times:=3;
  if w > rect.Width then
  begin
    lineCnt := rect.Height div h;
    while (rect.Width * lineCnt < w)AND (times>0) do // 如果不能满足
    begin
      Dec(FontSize); // 降低字号
      Printer.Canvas.Font.Size := FontSize;
      w := Printer.Canvas.TextWidth(Txt);
      h := Printer.Canvas.TextHeight(Txt);
      lineCnt := rect.Height div h;
      Dec(times);
    end;
    if rect.Width * lineCnt > w then
    begin
       trim:= (rect.Height-lineCnt* h) div 2;
       rect.Top:=rect.Top+trim;
       rect.Bottom:=rect.Bottom-trim;
    end;
    DrawText(Printer.Canvas.Handle, PChar(Txt), Length(Txt), rect,
      align + DT_WORDBREAK);
  end
  else
  begin
    DrawText(Printer.Canvas.Handle, PChar(Txt), Length(Txt), rect,
      align + DT_SINGLELINE);
  end;

end;

procedure DrawLine(BX, BY, EX, EY, OFFX, OFFY: integer);

begin

  BX := BX + OFFX;
  BY := BY + OFFY;
  EX := EX + OFFX;
  EY := EY + OFFY;
  BX := Round(BX * HPointsPerInch / 25.4);
  BY := Round(BY * HPointsPerInch / 25.4);
  EX := Round(EX * HPointsPerInch / 25.4);
  EY := Round(EY * HPointsPerInch / 25.4);
  Printer.Canvas.Pen.Width := 2;
  Printer.Canvas.MoveTo(BX, EY);
  Printer.Canvas.LineTo(EX, BY);

end;

end.
